home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / cli / mx2src.arc / ATOMIC.MOD < prev    next >
Encoding:
Modula Implementation  |  1989-01-05  |  30.5 KB  |  968 lines
  1.  
  2. (*              Copyright 1987,1988 fred brooks LogicTek        *)
  3. (*                                                              *)
  4. (*                                                              *)
  5. (*   First Release                      12/8/87-FGB             *)
  6. (*                                                              *)
  7. (* Modified TermProcess to also kill all the children processes *)
  8. (* of the parent. Changed FindProcess not to find zombies       *)
  9. (*                                      12/11/87-FGB            *)
  10. (*                                                              *)
  11. (* Added variable parm to StartProcess to pass info to process  *)
  12. (* in currentprocess.gemsave[15]        1/1/88-FGB              *)
  13. (* The PID of the new process will be returned in variable parm *)
  14. (*                                      2/24/88-FGB             *)
  15. (*                                                              *)
  16. (* Added DozeProcess to allow timed a sleep of processes        *)
  17. (*                                      2/21/88-FGB             *)
  18. (*                                                              *)
  19. (* Remove monitor priority. Each routine the switches processes *)
  20. (* must be protected from all interrupts by the IntEnd and      *)
  21. (* IntBegin calls. If this is not done correctly the system     *)
  22. (* system will bomb.                    4/4/88-FGB              *)
  23. (*                                                              *)
  24.  
  25.  
  26. (*$T-,$S-,$A+ *)
  27. IMPLEMENTATION MODULE          ATOMIC;
  28.  
  29. FROM  SYSTEM  IMPORT   ADR,TSIZE,
  30.                        CODE,SETREG,ADDRESS,REGISTER;
  31. FROM  NEWSYS  IMPORT   NEWPROCESS,PROCESS,TRANSFER,IOTRANSFER;
  32. FROM  XBIOS   IMPORT   SuperExec;
  33. FROM  BitStuff IMPORT   LAnd;
  34.  
  35. FROM  GEMDOS  IMPORT   GetTime,GetDate,Super;
  36.  
  37. FROM  Storage IMPORT   ALLOCATE,DEALLOCATE;
  38.  
  39. FROM  Strings IMPORT   String;
  40.  
  41. TYPE    workspace       =       ARRAY [0..254] OF CARDINAL;
  42.         savetype        =       POINTER TO ARRAY [0..22] OF CARDINAL;
  43.         sigs            =       (sleep,wakeup,terminate,trace,routine,
  44.                                  program,wait,gem,tos);
  45.         CPFlagtype      =       SET OF sigs;
  46.         CPFlagptrtype   =       POINTER TO CPFlagtype;
  47.  
  48. CONST   trapvec         =       110H; (* vector on IOTRANSFER *)
  49.         offsetvec       =       140H; (* offset IOTRANSFER vector *)
  50.         intnum          =       4;    (* interrupt number on MFP *)
  51.  
  52. VAR        s0,s1,s2,schedproc,s,
  53.            initproc,lastproc    :       SIGNAL;
  54.            kin                  :       ARRAY [0..32] OF INTEGER;
  55.            wsp0,wsp1,wsp2,wsp3  :       workspace;
  56.            wsp,bios             :       ADDRESS;
  57.            etimer [400H]        :       ADDRESS;
  58.            biospointer [4a2H]   :       ADDRESS;
  59.            ptermvec     [408H]  :       ADDRESS;
  60.            trap [trapvec]       :       ADDRESS;
  61.            memtop [436H]        :       ADDRESS;
  62.            flock [43eH]         :       CARDINAL;
  63.            hz200  [4baH]        :       LONGCARD;
  64.            temphz200,TICKS      :       LONGCARD;
  65.            sysvector [144H]     :       POINTER TO sysvariable;
  66.            accsuperstack        :       ADDRESS;
  67.            sysvar               :       sysvariable;
  68.            linea [28H]          :       ADDRESS;
  69.            gemdos [84H]         :       ADDRESS;
  70.            gsxgem [88H]         :       ADDRESS;
  71.            tbios  [0b4H]        :       ADDRESS;
  72.            xbios  [0b8H]        :       ADDRESS;
  73.            linef  [2cH]         :       ADDRESS;
  74.            level2 [68H]         :       ADDRESS;
  75.            level4 [70H]         :       ADDRESS;
  76.            shellp [4F6H]        :       ADDRESS;
  77.            oldtrap,oldtermvec   :       ADDRESS;
  78.            OldEtimer,sspval     :       ADDRESS;
  79.            p,cotick,x,t,temp    :       PROCESS;
  80.            processesid,I        :       INTEGER;
  81.            zombie               :       BOOLEAN;
  82.            children,highpri     :       INTEGER;
  83.            savefrom,saveto      :       savetype;
  84.            CPFlagptr            :       CPFlagptrtype;
  85.  
  86.         (* --------------  BEGIN -------------- *)
  87.  
  88. PROCEDURE       StartProcess(VAR P        : PROC;
  89.                              VAR n        : LONGCARD;
  90.                              VAR priority : INTEGER;
  91.                              VAR pn       : String;
  92.                              VAR parm     : ADDRESS);
  93. BEGIN
  94.         IntEnd;
  95.         SuperExec(UpdatecurrentProc);
  96.         ALLOCATE(wsp,n);
  97.         IF wsp=NIL THEN
  98.            currentprocess^.errno:=12;
  99.            IntBegin;
  100.            RETURN;
  101.         END;
  102.         DEC(sysmemsize,n);
  103.         s1:=currentprocess;
  104.         s0:=currentprocess;
  105.  
  106.         IF processesid>0 THEN    (* search only after setup of SCHED *)
  107.         s0:=schedproc;               (* set to sched process *)
  108.          LOOP                    (* find zombie process *)
  109.           s0:=s0^.next;
  110.           IF s0^.pid=1 THEN      (* zombie not found in list *)
  111.              EXIT;
  112.           END;
  113.           FindZombieProcess(zombie);
  114.           IF zombie THEN EXIT END;
  115.          END;
  116.         END; (* if processesid>1 *)
  117.  
  118.         IF zombie THEN
  119.            currentprocess:=s0;
  120.         ELSE
  121.            ALLOCATE(currentprocess,TSIZE(ProcessDescriptor));
  122.            IF currentprocess=NIL THEN
  123.               s1^.errno:=12;
  124.               IntBegin;
  125.               RETURN;
  126.            END;
  127.            DEC(sysmemsize,TSIZE(ProcessDescriptor));
  128.            INC(processesid);
  129.            currentprocess^.pid:=processesid;
  130.            currentprocess^.next:=initproc; lastproc^.next:=currentprocess;
  131.            lastproc:=currentprocess;
  132.         END;
  133.  
  134.         WITH currentprocess^ DO
  135.              name:=pn;
  136.              ppid:=request.pid;
  137.              ready:=TRUE; active:=TRUE;
  138.              tick:=0;
  139.              IF priority<1 THEN priority:=1 END;
  140.              IF priority>10 THEN priority:=10 END;
  141.              pri:=priority;
  142.              misc[0]:=pri;
  143.              IF pri>highpri THEN highpri:=pri END;
  144.              GetTime(time);
  145.              GetDate(date);
  146.              gemsave[13]:=0; (* set timer to zero *)
  147.              gemsave[14]:=0; (* set all flags to zero *)
  148.              gemsave[15]:=parm;
  149.              parm:=ADDRESS(currentprocess^.pid);
  150.              Iport:=s1^.Iport;
  151.              Oport:=s1^.Oport;
  152.         END;
  153.         IF currentprocess^.pid>1 THEN
  154.            FindProcess(request.pid,s2);
  155.            s2^.return:=currentprocess^.pid;
  156.         ELSE
  157.            currentprocess^.return:=0;
  158.         END;
  159.         SuperExec(SetSlice);
  160.         currentprocess^.slice:=temphz200;
  161.         currentprocess^.wsp:=wsp;
  162.         currentprocess^.wspsize:=n;
  163.         NEWPROCESS(P,wsp,n,currentprocess^.cor);
  164.         SuperExec(intbiosptr);
  165.         s1^.errno:=0;
  166.         INC(contextswitch);            (* update switch counter *)
  167.         TRANSFER(s1^.cor,currentprocess^.cor);
  168.         IntBegin;
  169. END     StartProcess;
  170.  
  171. PROCEDURE       TermProcess(VAR id: INTEGER);
  172. BEGIN
  173.         IF id<2 THEN RETURN END;
  174.         IntEnd;
  175.  
  176.         FindProcess(id,s2);
  177.         IF s2=NIL THEN
  178.            currentprocess^.errno:=3;
  179.            IntBegin;
  180.            RETURN;
  181.         END;
  182.         currentprocess^.errno:=0;
  183.  
  184.         s2^.active:=FALSE;      (* set flag *)
  185.         IF s2^.wsp#NIL THEN
  186.            DEALLOCATE(s2^.wsp,s2^.wspsize);
  187.            INC(sysmemsize,s2^.wspsize);
  188.         END;
  189.         s2^.wsp:=NIL;           (* set TO NIL to make zombie process *)
  190.         s0:=currentprocess; (* set to the parent process *)
  191.  
  192.         kin[0]:=id;
  193.         REPEAT (* loop thru process list and find all related processes *)
  194.         FindChildProcess(kin[0],s1);
  195.         WHILE s1#NIL DO
  196.            INC(children);
  197.            kin[children]:=s1^.pid;
  198.            s1^.active:=FALSE;      (* set flag *)
  199.            s1^.gemsave[14]:=0; (* reset all flags *)
  200.            IF s1^.wsp#NIL THEN
  201.               DEALLOCATE(s1^.wsp,s1^.wspsize);
  202.               INC(sysmemsize,s1^.wspsize);
  203.            END;
  204.            s1^.wsp:=NIL;           (* set TO NIL to make zombie process *)
  205.            currentprocess:=s1;     (* set currentprocess to terminated *)
  206.            SuperExec(IncSlice);    (* update cpu time for terminated *)
  207.            FindChildProcess(kin[0],s1);
  208.         END;
  209.         kin[0]:=kin[children];
  210.         DEC(children);
  211.         UNTIL children<0;
  212.         currentprocess:=s0;
  213.  
  214.         currentprocess^.errno:=0;
  215.         s1:=currentprocess;     (* save currentprocess *)
  216.         currentprocess:=s2;     (* set currentprocess to terminated *)
  217.         SuperExec(UpdatecurrentProc);  (* update cpu time for terminated *)
  218.  
  219.  
  220.         currentprocess:=schedproc;  (* set to transfer to the sched *)
  221.  
  222.         IF s1^.pid#id THEN
  223.            temp:=s1^.cor; (* currentprocess different than terminated *)
  224.         ELSE
  225.            temp:=t;     (* process the same so set up dummy process *)
  226.         END;
  227.  
  228.         IF s1^.pid#1 THEN
  229.            SuperExec(UpdateProc);
  230.            TRANSFER(temp,currentprocess^.cor); (* do context switch *)
  231.         END;
  232.         IntBegin;
  233. END             TermProcess;
  234.  
  235. PROCEDURE       NextPid(): INTEGER;
  236. BEGIN
  237.         s1:=currentprocess;
  238.         s0:=currentprocess;
  239.  
  240.         IF processesid>0 THEN    (* search only after setup of SCHED *)
  241.         s0:=schedproc;               (* set to sched process *)
  242.          LOOP                    (* find zombie process *)
  243.           s0:=s0^.next;
  244.           IF s0^.pid=1 THEN      (* zombie not found in list *)
  245.              EXIT;
  246.           END;
  247.           FindZombieProcess(zombie);
  248.           IF zombie THEN EXIT END;
  249.          END;
  250.         END; (* if processesid>1 *)
  251.  
  252.         IF zombie THEN
  253.            RETURN s0^.pid;
  254.         ELSE
  255.            RETURN processesid+1;
  256.         END;
  257. END             NextPid;
  258.  
  259. PROCEDURE       SleepProcess(VAR id: INTEGER);
  260. BEGIN
  261.         IF id<2 THEN RETURN END;
  262.  
  263.         IntEnd;
  264.         FindProcess(id,s2);
  265.         IF s2=NIL THEN
  266.            currentprocess^.errno:=3;
  267.            IntBegin;
  268.            RETURN;
  269.         END;
  270.         currentprocess^.errno:=0;
  271.  
  272.         IF (s2^.wsp#NIL) AND (NOT s2^.active) THEN IntBegin; RETURN END;
  273.         IF s2^.wsp#NIL THEN 
  274.            s2^.active:=FALSE;      (* set flag *)
  275.            CPFlagptr:=ADR(s2^.gemsave[14]);
  276.            INCL(CPFlagptr^,sleep);
  277.            s2^.gemsave[13]:=0;
  278.         END;
  279.  
  280.         s1:=currentprocess;     (* save currentprocess *)
  281.         SuperExec(UpdatecurrentProc);    (* update cpu time for sleeper *)
  282.  
  283.         currentprocess:=schedproc;  (* set to transfer to the sched *)
  284.  
  285.         IF s1^.pid#1 THEN
  286.            s1^.ready:=FALSE; currentprocess^.ready:=TRUE;
  287.            SuperExec(UpdateProc);
  288.            TRANSFER(s1^.cor,currentprocess^.cor); (* do context switch *)
  289.         END;
  290.         IntBegin;
  291. END             SleepProcess;
  292.  
  293. PROCEDURE       DozeProcess(VAR id: INTEGER; VAR msec : LONGCARD);
  294. BEGIN
  295.         IF id<2 THEN RETURN END;
  296.  
  297.         IntEnd;
  298.         FindProcess(id,s2);
  299.         IF s2=NIL THEN
  300.            currentprocess^.errno:=3;
  301.            IntBegin;
  302.            RETURN;
  303.         END;
  304.         currentprocess^.errno:=0;
  305.  
  306.         IF (s2^.wsp#NIL) AND (NOT s2^.active) THEN
  307.            IntBegin;
  308.            RETURN;
  309.         END;
  310.         IF s2^.wsp#NIL THEN 
  311.            s2^.active:=FALSE;      (* set flag *)
  312.            CPFlagptr:=ADR(s2^.gemsave[14]);
  313.            INCL(CPFlagptr^,sleep);
  314.            IF msec#0 THEN
  315.                 SuperExec(SetSlice);
  316.                 s2^.gemsave[13]:=ADDRESS(temphz200+(msec DIV 5));
  317.            ELSE
  318.                 s2^.gemsave[13]:=0;
  319.            END;
  320.         END;
  321.  
  322.         s1:=currentprocess;     (* save currentprocess *)
  323.         SuperExec(getbiosptr);
  324.         SuperExec(UpdatecurrentProc);    (* update cpu time for sleeper *)
  325.  
  326.         currentprocess:=schedproc;  (* set to transfer to the sched *)
  327.  
  328.         IF s1^.pid#1 THEN
  329.            s1^.ready:=FALSE; currentprocess^.ready:=TRUE;
  330.            SuperExec(UpdateProc);
  331.            TRANSFER(s1^.cor,currentprocess^.cor); (* do context switch *)
  332.         END;
  333.         IntBegin;
  334. END             DozeProcess;
  335.  
  336. PROCEDURE       WaitProcess(VAR id: INTEGER; VAR loc: ADDRESS;
  337.                             VAR value,mask,msec : LONGCARD);
  338. BEGIN
  339.         IF id<2 THEN RETURN END;
  340.  
  341.         IntEnd;
  342.         FindProcess(id,s2);
  343.         IF s2=NIL THEN
  344.            currentprocess^.errno:=3;
  345.            IntBegin;
  346.            RETURN;
  347.         END;
  348.         currentprocess^.errno:=0;
  349.  
  350.         IF (s2^.wsp#NIL) AND (NOT s2^.active) THEN
  351.            IntBegin;
  352.            RETURN;
  353.         END;
  354.         IF s2^.wsp#NIL THEN 
  355.            s2^.active:=FALSE;      (* set flag *)
  356.            CPFlagptr:=ADR(s2^.gemsave[14]);
  357.            INCL(CPFlagptr^,sleep);
  358.            INCL(CPFlagptr^,wait);
  359.            s2^.waitloc:=loc;
  360.            s2^.gemsave[11]:=ADDRESS(value);
  361.            s2^.gemsave[12]:=ADDRESS(mask);
  362.            IF msec#0 THEN
  363.                 SuperExec(SetSlice);
  364.                 s2^.gemsave[13]:=ADDRESS(temphz200+(msec DIV 5));
  365.            ELSE
  366.                 s2^.gemsave[13]:=0;
  367.            END;
  368.         END;
  369.  
  370.         s1:=currentprocess;     (* save currentprocess *)
  371.         SuperExec(UpdatecurrentProc);    (* update cpu time for sleeper *)
  372.  
  373.         currentprocess:=schedproc;  (* set to transfer to the sched *)
  374.  
  375.         IF s1^.pid#1 THEN
  376.            s1^.ready:=FALSE; currentprocess^.ready:=TRUE;
  377.            SuperExec(UpdateProc);
  378.            TRANSFER(s1^.cor,currentprocess^.cor); (* do context switch *)
  379.         END;
  380.         IntBegin;
  381. END             WaitProcess;
  382.  
  383. PROCEDURE       WakeupProcess(VAR id: INTEGER);
  384. BEGIN
  385.         IF id<2 THEN RETURN END;
  386.  
  387.         IntEnd;
  388.         FindProcess(id,s2);
  389.         IF s2=NIL THEN
  390.            currentprocess^.errno:=3;
  391.            IntBegin;
  392.            RETURN;
  393.         END;
  394.  
  395.         IF (s2^.wsp#NIL) AND s2^.active THEN 
  396.            currentprocess^.errno:=0;
  397.            IntBegin;
  398.            RETURN; (* already awake *)
  399.         END;
  400.  
  401.         IF s2^.wsp#NIL THEN 
  402.            s2^.active:=TRUE;      (* set flag *)
  403.            CPFlagptr:=ADR(s2^.gemsave[14]);
  404.            EXCL(CPFlagptr^,sleep);
  405.            currentprocess^.errno:=0;
  406.         ELSE
  407.            currentprocess^.errno:=3;
  408.         END;
  409.         IntBegin;
  410. END             WakeupProcess;
  411.  
  412. (* V0.7 *)
  413. PROCEDURE       ChangeProcessPriority(VAR id: INTEGER; VAR pri: INTEGER);
  414. BEGIN
  415.         IF id<2 THEN RETURN END;
  416.  
  417.         IntEnd;
  418.         FindProcess(id,s2);
  419.         IF s2=NIL THEN
  420.            currentprocess^.errno:=3;
  421.            IntBegin;
  422.            RETURN;
  423.         END;
  424.  
  425.         IF pri<1  THEN pri:=1 END;
  426.         IF pri>10 THEN pri:=10 END;
  427.         s2^.pri:=pri;
  428.         IntBegin;
  429. END             ChangeProcessPriority;
  430.  
  431. PROCEDURE       InitProcesses;
  432. BEGIN
  433.         CRON:=dummy;
  434.         ALLOCATE(currentprocess,TSIZE(ProcessDescriptor));
  435.         DEC(sysmemsize,TSIZE(ProcessDescriptor));
  436.         processesid:=0;
  437.         initproc:=currentprocess;
  438.         lastproc:=initproc;
  439.         WITH currentprocess^ DO
  440.              next:=currentprocess;
  441.              ready:=FALSE;
  442.              active:=FALSE;
  443.              name:="INIT";
  444.              GetTime(time);
  445.              GetDate(date);
  446.         END;
  447.         NEWPROCESS(dummy,ADR(wsp1),TSIZE(workspace),x);
  448.         NEWPROCESS(dummy,ADR(wsp2),TSIZE(workspace),p);
  449.         NEWPROCESS(dummy,ADR(wsp3),TSIZE(workspace),t);
  450.         currentprocess^.wsp:=ADR(wsp2);
  451.         currentprocess^.cor:=p;
  452. END             InitProcesses;
  453.  
  454. PROCEDURE       EndProcesses;
  455. BEGIN
  456.         s0:=currentprocess;
  457.         REPEAT
  458.                 currentprocess:=s0^.next;
  459.                 s0:=currentprocess;
  460.         UNTIL currentprocess^.pid=0;
  461.         SuperExec(restorebiosptr);
  462.         INC(contextswitch);            (* update switch counter *)
  463.         TRANSFER(currentprocess^.cor,currentprocess^.cor);
  464. END     EndProcesses;
  465.  
  466. (* This is the scheduler which is called by newtrap *)
  467. PROCEDURE       sched;  
  468. BEGIN
  469.         IOTRANSFER(cotick,x,ADDRESS(trapvec)); (* V1.1 baud rate timer *)
  470.         LOOP                                (* interrupt not used by ST *)
  471.              currentprocess^.cor:=x;
  472.              currentprocess^.ready:=FALSE;
  473.              currentprocess^.intflag:=TRUE; (* process interrupted *)
  474.              INC(contextswitch);            (* update switch counter *)
  475.              currentprocess:=s0; (* s0 set to new in newtrap procedure *)
  476.              currentprocess^.ready:=TRUE;   (* process to start *)
  477.              x:=currentprocess^.cor;
  478.              IOTRANSFER(cotick,x,ADDRESS(offsetvec)); (* offset vector so not *)
  479.         END;                                     (* to overwrite the     *)
  480. END     sched;                                   (* newtrap vector       *)
  481.  
  482. PROCEDURE       SwapProcess; (* swap out processes *)
  483. BEGIN
  484.         IntEnd;
  485.         SuperExec(UpdatecurrentProc);
  486.         s0:=currentprocess;
  487.         currentprocess^.ready:=FALSE;
  488.         LOOP (* find next process *)
  489.           currentprocess:=currentprocess^.next;
  490.           IF currentprocess^.active AND (currentprocess^.wsp#NIL) THEN 
  491.              EXIT 
  492.           END;
  493.         END; (* loop *)
  494.         currentprocess^.ready:=TRUE;
  495.         IF s0^.pid#currentprocess^.pid THEN
  496.            SuperExec(UpdateProc);
  497.            TRANSFER(s0^.cor,currentprocess^.cor);
  498.         END;
  499.         IntBegin;
  500. END     SwapProcess;
  501.  
  502. (*$P- *)
  503. PROCEDURE       UpdateProc; (* update all currentprocess values *)
  504. BEGIN
  505.         currentprocess^.slice:=hz200;
  506.         ClrInt;
  507.         SetTimer;
  508.         setbiosptr;
  509.         INC(contextswitch);            (* update switch counter *)
  510.         CODE(4e75H); (* rts *)
  511. END     UpdateProc;
  512. (*$P+ *)
  513.  
  514. (*$P- *)
  515. PROCEDURE       UpdatecurrentProc;
  516. BEGIN
  517.         getbiosptr;
  518.         IncSlice;
  519.         CODE(4e75H); (* rts *)
  520. END             UpdatecurrentProc;
  521. (*$P+ *)
  522.  
  523. PROCEDURE       dummy; (* dummy procedure to make newprocess *)
  524. BEGIN
  525. END             dummy;
  526.  
  527. PROCEDURE       d1(): BOOLEAN;
  528. BEGIN
  529. END             d1;
  530.  
  531. PROCEDURE       d2(c: CHAR);
  532. BEGIN
  533. END             d2;
  534.  
  535. PROCEDURE       d3(): LONGCARD;
  536. BEGIN
  537. END             d3;
  538. (* check to see if process s0 is a ZOMBIE, if so return true else false *)
  539. PROCEDURE       FindZombieProcess(VAR zombie: BOOLEAN);
  540. BEGIN
  541.           IF (NOT s0^.active) AND (s0^.pid#0) AND (s0^.wsp=NIL) THEN 
  542.              zombie:=TRUE; (* found one *)
  543.           ELSE
  544.              zombie:=FALSE; (* nada it's alive! *)
  545.           END;
  546. END             FindZombieProcess;
  547.  
  548. PROCEDURE       FindProcess(VAR pid: INTEGER; VAR fp: SIGNAL);
  549. BEGIN
  550.         s:=schedproc;
  551.         LOOP                    (* find  process id *)
  552.           s:=s^.next;
  553.           IF (s^.pid=pid) AND (s^.wsp#NIL) THEN     (* found id *)
  554.              fp:=s;
  555.              EXIT;
  556.           END;
  557.           IF s^.pid=schedproc^.pid THEN      (* id not found in list *)
  558.              fp:=NIL;
  559.              EXIT;
  560.           END;
  561.         END;
  562. END     FindProcess;
  563.  
  564. PROCEDURE       FindChildProcess(VAR pid: INTEGER; VAR fp: SIGNAL);
  565. BEGIN
  566.         s:=schedproc;
  567.         LOOP                    (* find  process child id *)
  568.           s:=s^.next;
  569.           IF (s^.ppid=pid) AND (s^.wsp#NIL) THEN     (* found id *)
  570.              fp:=s;
  571.              EXIT;
  572.           END;
  573.           IF s^.pid=schedproc^.pid THEN      (* id not found in list *)
  574.              fp:=NIL;
  575.              EXIT;
  576.           END;
  577.         END;
  578. END     FindChildProcess;
  579.  
  580. (*$P- *)
  581. PROCEDURE   IncSlice; (* UPDATE cpu time  *)
  582. BEGIN
  583.         INC(currentprocess^.tick,hz200-currentprocess^.slice);
  584.         currentprocess^.slice:=hz200;
  585.         CODE(4e75H); (* rts *)
  586. END         IncSlice;
  587. (*$P+ *)
  588.  
  589. (*$P- *)
  590. PROCEDURE   SetSlice; (* start timeslice  *)
  591. BEGIN
  592.         temphz200:=hz200;
  593.         CODE(4e75H); (* rts *)
  594. END         SetSlice;
  595. (*$P+ *)
  596.  
  597. (*$P- *)
  598. PROCEDURE   SetTimer; (* setup number of ticks before switch V1.1  *)
  599. BEGIN
  600.         TICKS:=hz200+LONGCARD(currentprocess^.pri*10);
  601.         CODE(4e75H);            (* rts *)
  602. END         SetTimer;
  603. (*$P+ *)
  604.  
  605. (*$P- *)
  606. PROCEDURE   ClrInt; (* V1.2 change to int on mfp *)
  607. BEGIN
  608.         CODE(8b9H,intnum,0ffffH,0fa11H); (* BCLR intnum, ISRB *)
  609.         CODE(8b9H,intnum,0ffffH,0fa15H); (* BCLR intnum, MASKB *)
  610.         CODE(4e75H);               (* rts *)
  611. END         ClrInt;
  612. (*$P+ *)
  613.  
  614. (*$P- *)
  615. PROCEDURE   EnableInterrupt;
  616. BEGIN                           (* setup sched vector interrupt *)
  617.         SETREG(8,0fffffa15H);   (* load a0 with adr of mfp reg *)
  618.         CODE(8d0H,intnum);  (* set int mask bit *)
  619.         CODE(4e75H);            (* rts *)
  620. END         EnableInterrupt;
  621. (*$P+ *)
  622.  
  623. PROCEDURE       MultiBegin;
  624. BEGIN
  625.         SuperExec(ClrInt);
  626.         SuperExec(SetTimer);
  627.         MULTI:=TRUE;
  628. END             MultiBegin;
  629.  
  630. PROCEDURE       MultiEnd;
  631. BEGIN
  632.         MULTI:=FALSE;
  633.         SuperExec(ClrInt);
  634. END             MultiEnd;
  635.  
  636. PROCEDURE       IntBegin;
  637. VAR     ssv     :       ADDRESS;
  638. BEGIN
  639.         ssv:=0H;
  640.         Super(ssv);
  641.         CODE(46fcH,2300H);  (* start interrupts *)
  642.         Super(ssv);
  643. END             IntBegin;
  644.  
  645. PROCEDURE       IntEnd;
  646. VAR     ssv     :       ADDRESS;
  647. BEGIN
  648.         ssv:=0H;
  649.         Super(ssv);
  650.         CODE(46fcH,2700H);  (* stop interrupts *)
  651.         Super(ssv);
  652. END             IntEnd;
  653.  
  654. (*$P- *)
  655. PROCEDURE       getbiosptr;
  656. BEGIN
  657.         WITH currentprocess^ DO
  658.                 biosval:=biospointer+46;
  659.                 termvec:=ptermvec;
  660.                 gemsave[0]:=gemsaveGvec^;
  661.                 gemsave[1]:=linea;
  662.                 gemsave[2]:=gemdos;
  663.                 gemsave[3]:=gsxgem;
  664.                 gemsave[4]:=tbios;
  665.                 gemsave[5]:=xbios;
  666.                 gemsave[6]:=linef;
  667.                 gemsave[7]:=level2;
  668.                 gemsave[8]:=level4;
  669.                 gemsave[9]:=shellp;
  670.         END;
  671.         CODE(4e75H);               (* rts *)
  672. END             getbiosptr;
  673. (*$P+ *)
  674.  
  675. (*$P- *)
  676. PROCEDURE       setbiosptr;
  677. BEGIN
  678.         WITH currentprocess^ DO
  679.         savefrom:=ADDRESS(biospointer);
  680.         saveto:=ADDRESS(biosval-46);
  681.         saveto^:=savefrom^;
  682.         biospointer:=biosval-46;
  683.         ptermvec:=termvec;
  684.         gemsaveGvec^:=gemsave[0];
  685.         linea:=gemsave[1];
  686.         gemdos:=gemsave[2];
  687.         gsxgem:=gemsave[3];
  688.         tbios:=gemsave[4];
  689.         xbios:=gemsave[5];
  690.         linef:=gemsave[6];
  691.         level2:=gemsave[7];
  692.         level4:=gemsave[8];
  693.         shellp:=gemsave[9];
  694.         END;
  695.         CODE(4e75H);               (* rts *)
  696. END             setbiosptr;
  697. (*$P+ *)
  698.  
  699. (*$P- *)
  700. PROCEDURE       restorebiosptr;
  701. BEGIN
  702.         savefrom:=biospointer;
  703.         saveto:=bios;
  704.         saveto^:=savefrom^;
  705.         biospointer:=bios;
  706.         ptermvec:=oldtermvec;
  707.         CODE(4e75H);               (* rts *)
  708. END             restorebiosptr;
  709. (*$P+ *)
  710.  
  711. (*$P- *)
  712. PROCEDURE       intbiosptr;
  713. BEGIN
  714.         WITH currentprocess^ DO
  715.         savefrom:=ADDRESS(biospointer);
  716.         saveto:=ADR(biosave[199]);
  717.         saveto^:=savefrom^;
  718.         biosval:=ADR(biosave[199]);
  719.         biospointer:=biosval;
  720.         termvec:=ptermvec;
  721.         gemsave[0]:=gemsaveGvec^;
  722.         gemsave[1]:=linea;
  723.         gemsave[2]:=gemdos;
  724.         gemsave[3]:=gsxgem;
  725.         gemsave[4]:=tbios;
  726.         gemsave[5]:=xbios;
  727.         gemsave[6]:=linef;
  728.         gemsave[7]:=level2;
  729.         gemsave[8]:=level4;
  730.         gemsave[9]:=shellp;
  731.         END;
  732.         CODE(4e75H);               (* rts *)
  733. END             intbiosptr;
  734. (*$P+ *)
  735.  
  736. (*$P- *) 
  737. PROCEDURE       newtrap; (* IOTRANSFER executes this code before its *)
  738. BEGIN                    (* normal vector. *)
  739.  
  740.         CODE(46fcH,2700H);  (* stop interrupts *)
  741.         CODE(8b9H,intnum,0ffffH,0fa11H); (* BCLR intnum, ISRB *)
  742.         CODE(8b9H,intnum,0ffffH,0fa15H); (* BCLR intnum, MASKB *)
  743.         CODE(817H,5);                 (* BTST 5, (a7) check supermode *)
  744.         CODE(6700H+2);                (* BEQ.S over rte *)
  745.         CODE(4e73H);                  (* RTE supermode return *)
  746.         CODE(48e7H,0fffeH);   (* save regs movem  *)
  747.         CODE(204fH);    (* move.l ssp,a0 *)
  748.         currentprocess^.ssp:=REGISTER(8)+66;
  749.  
  750.         IF (currentprocess^.ssp#sspval)
  751.            AND (currentprocess^.ssp#accsuperstack) THEN
  752.            CODE(4cdfH,7fffH); (* restore regs movem *)
  753.            CODE(4e73H);       (* rte *)
  754.         ELSE
  755.  
  756.            IncSlice;   (* cpu time update *)
  757.            s0:=currentprocess;
  758.            LOOP                    (* find next process store in s0 *)
  759.               s0:=s0^.next;
  760.               WITH s0^ DO
  761.                 IF (gemsave[14]#0) THEN (* If flags set then process *)
  762.                    CPFlagptr:=ADR(gemsave[14]);
  763.  
  764.                    IF sleep IN CPFlagptr^ THEN (* sleep flag *)
  765.                       IF (gemsave[13]#0) AND
  766.                          (ADDRESS(hz200) >= gemsave[13]) THEN
  767.                          active:=TRUE;
  768.                          gemsave[13]:=0;
  769.                          EXCL(CPFlagptr^,wait);  (* clear wait flag *)
  770.                          EXCL(CPFlagptr^,sleep); (* clear sleep flag *)
  771.                       END;
  772.                    END;
  773.                    IF wait IN CPFlagptr^ THEN (* wait flag *)
  774.                       IF (waitloc^ = LONGCARD(LAnd(gemsave[11],gemsave[12]))) THEN
  775.                          active:=TRUE;
  776.                          gemsave[13]:=0;
  777.                          EXCL(CPFlagptr^,wait);  (* clear wait flag *)
  778.                          EXCL(CPFlagptr^,sleep); (* clear sleep flag *)
  779.                       END;
  780.                    END;
  781.  
  782.                 END;
  783.                 IF (active) AND (wsp#NIL) THEN
  784.                    IF misc[0]>=highpri THEN
  785.                       IF pri>highpri THEN highpri:=pri END;
  786.                       misc[0]:=pri;
  787.                       EXIT;
  788.                    ELSE
  789.                       INC(misc[0]); (* age process til it's ready to run *)
  790.                    END;
  791.                 END;
  792.               END; (* with *)
  793.            END; (* end LOOP *)
  794.  
  795.         (* Swap GEM pointers for the processes *)
  796.            WITH currentprocess^ DO
  797.            gemsave[0]:=gemsaveGvec^;
  798.            gemsave[1]:=linea;
  799.            gemsave[2]:=gemdos;
  800.            gemsave[3]:=gsxgem;
  801.            gemsave[4]:=tbios;
  802.            gemsave[5]:=xbios;
  803.            gemsave[6]:=linef;
  804.            gemsave[7]:=level2;
  805.            gemsave[8]:=level4;
  806.            gemsave[9]:=shellp;
  807.            biosval:=biospointer;
  808.            termvec:=ptermvec;
  809.            END;
  810.            WITH s0^ DO
  811.            biospointer:=biosval;
  812.            ptermvec:=termvec;
  813.            gemsaveGvec^:=gemsave[0];
  814.            linea:=gemsave[1];
  815.            gemdos:=gemsave[2];
  816.            gsxgem:=gemsave[3];
  817.            tbios:=gemsave[4];
  818.            xbios:=gemsave[5];
  819.            linef:=gemsave[6];
  820.            level2:=gemsave[7];
  821.            level4:=gemsave[8];
  822.            shellp:=gemsave[9];
  823.            END;
  824.  
  825.            SetTimer;
  826.            s0^.slice:=hz200; (* set next cycle start *)
  827.            SETREG(8,oldtrap);  (* move IOTRANSFER trap adr *)
  828.            CODE(43faH,10); (* lea 12(pc),a1 *)
  829.            CODE(2288H); (* move.l a0,(a1) *)
  830.            CODE(4cdfH,7fffH); (* restore regs movem *)
  831.            CODE(4ef9H,0,0) (* jmp back to routine *)
  832.         END;
  833. END     newtrap;
  834. (*$P+ *)
  835.  
  836. (*$P-,$S- *) 
  837. PROCEDURE       NewEtimer;
  838. BEGIN
  839.         CODE(48e7H,0fffeH);   (* save regs movem  *)
  840.            IF MULTI THEN 
  841.               CODE(207cH,0ffffH,0fa15H);  (* load a0 with adr of mfp reg *)
  842.               CODE(8d0H,intnum);      (* set int mask bit *) 
  843.               CODE(5188H);         (* subq.l 8 adj a0 to adr of mfp reg *)
  844.               CODE(5988H);         (* subq.l 4 adj a0 to adr of mfp reg *)
  845.               CODE(8d0H,intnum);      (* set int enable bit *) 
  846.            END;
  847.  
  848.            SETREG(8,OldEtimer);  (* move trap adr *)
  849.            CODE(43faH,6); (* lea 8(pc),a1 *)
  850.            CODE(2288H); (* move.l a0,(a1) *)
  851.            CODE(4ef9H,0,0); (* jmp back to routine *)
  852. END     NewEtimer;
  853. (*$P+,$S- *)
  854.  
  855. (*$P- *) (*save trap and set up flag trap for IOTRANSFER to run my code *)
  856. PROCEDURE       settrap;     (* before executing the IOTRANSFER.        *)
  857. BEGIN
  858.         CODE(46fcH,2700H);  (* stop interrupts  V1.1 use 200hz clock *) 
  859.         TICKS:=10;
  860.         OldEtimer:=etimer+4;
  861.         etimer:=ADDRESS(NewEtimer);
  862.         EnableInterrupt;
  863.         MULTI:=FALSE;
  864.         oldtrap:=trap+4;        (* add 4 to skip over set SR to 2700 *)
  865.         trap:=ADDRESS(newtrap);
  866.         CODE(46fcH,2300H);      (* allow interrupts V1.1 *) 
  867.         accsuperstack:=sysvector; (* load value from MX2.ACC *)
  868.         sysvector:=ADR(sysvar);         (* setup sysvar pointers *)
  869.         sysvar.currentprocess:=ADR(currentprocess);
  870.         sysvar.MULTI:=ADR(MULTI);
  871.         sysvar.slicebegin:=ADR(slicebegin);
  872.         sysvar.command:=ADR(command);
  873.         sysvar.request:=ADR(request);
  874.         sysvar.contextswitch:=ADR(contextswitch);
  875.         sysvar.CRON:=ADR(CRON);
  876.         sysvar.spintenable:=ADR(spintenable);
  877.         sysvar.spintmask:=ADR(spintmask);
  878.  
  879.         sysvar.spint:=ADR(spint[0]);
  880.         sysvar.bpsave:=ADR(bpsave);
  881.         sysvar.pipes:=ADR(pipes);
  882.         sysvar.sysmemsize:=ADR(sysmemsize);
  883.         sysvar.gemsaveGvec:=ADR(gemsaveGvec);
  884.         sysvar.StartProcess:=StartProcess;
  885.         sysvar.SwapProcess:=SwapProcess;
  886.         sysvar.TermProcess:=TermProcess;
  887.         sysvar.NextPid:=NextPid;
  888.         sysvar.SleepProcess:=SleepProcess;
  889.         sysvar.WakeupProcess:=WakeupProcess;
  890.         sysvar.ChangeProcessPriority:=ChangeProcessPriority;
  891.         sysvar.MultiBegin:=MultiBegin;
  892.         sysvar.MultiEnd:=MultiEnd;
  893.         sysvar.DozeProcess:=DozeProcess;
  894.         sysvar.WaitProcess:=WaitProcess;
  895.         sysvar.CronActive:=ADR(CronActive);
  896.         sysvar.DeviceTable:=ADR(DeviceTable);
  897.         FOR I:=ORD(dev0) TO ORD(dev7) DO   (* setup user device table *)
  898.             DeviceTable[I].bconstat:=devstattype(d1);
  899.             DeviceTable[I].bcostat:=devstattype(d1);
  900.             DeviceTable[I].bconin:=devintype(d3);
  901.             DeviceTable[I].bconout:=devouttype(d2);
  902.         END;
  903.         FOR I:=0 TO 31 DO       (* clear all pipes *)
  904.             pipes[I]:=NIL;
  905.         END;
  906.         FOR I:=0 TO 15 DO       (* clear all spints *)
  907.             spint[I].proc:=PROC(NIL);
  908.         END;
  909.         slicebegin:=hz200;
  910.         contextswitch:=0;
  911.         bios:=biospointer;      (* save original pointer *)
  912.         oldtermvec:=ptermvec;
  913.         CODE(4e75H); (* rts *)
  914.  
  915. END     settrap;
  916. (*$P+ *)
  917.  
  918. PROCEDURE       Initsked;
  919. VAR             a,b,ssv     :       ADDRESS;
  920. BEGIN
  921.         MultiEnd;
  922.         a:=ADDRESS(OTOS);
  923.         b:=ADDRESS(MTOS);
  924.         gemsaveGvec:=a;
  925.         IF ROMDATE=NEWDATE THEN gemsaveGvec:=b END;
  926.         SuperExec(SetTimer);
  927.         NEWPROCESS(sched,ADR(wsp0),TSIZE(workspace),cotick);
  928.         TRANSFER(x,cotick);
  929.         schedproc:=currentprocess;
  930.         SuperExec(settrap);
  931.         ssv:=0H;
  932.         Super(ssv);
  933.         sspval:=ssv;
  934.         Super(ssv);
  935. END             Initsked;
  936.  
  937. PROCEDURE       CheckFlag(VAR flag: BOOLEAN): BOOLEAN;
  938. BEGIN
  939.         IF flag THEN
  940.            RETURN TRUE;
  941.         ELSE
  942.            RETURN FALSE;
  943.         END;
  944. END     CheckFlag;
  945.  
  946. PROCEDURE       SetFlag(VAR flag: BOOLEAN);
  947. BEGIN
  948.         flag:=TRUE;
  949. END     SetFlag;
  950.  
  951. PROCEDURE       ResetFlag(VAR flag: BOOLEAN);
  952. BEGIN
  953.         flag:=FALSE;
  954. END     ResetFlag;
  955.  
  956. PROCEDURE       CheckResetFlag(VAR flag: BOOLEAN): BOOLEAN;
  957. BEGIN
  958.         IF flag THEN
  959.            flag:=FALSE;
  960.            RETURN TRUE;
  961.         ELSE
  962.            RETURN FALSE;
  963.         END;
  964. END     CheckResetFlag;
  965.  
  966. BEGIN
  967. END     ATOMIC.
  968.